home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / pctjmr86.arc / SPMMLIB.PAS < prev    next >
Pascal/Delphi Source File  |  1985-12-16  |  4KB  |  131 lines
  1. {-------------------------------------------}
  2. { SUB-PROCESS AND MEMORY MANAGEMENT LIBRARY }
  3. {-------------------------------------------}
  4. type
  5.    r8086=
  6.       record
  7.       ax,bx,cx,dx,bp,di,si,ds,es,flags:integer;
  8.       end;
  9.    asciiz=string[65];
  10.  
  11. var regs:r8086;
  12.  
  13. { ---------------- REDUCE MEMORY ALLOCATION }
  14. function dos4AH(pp_to_release:integer):integer;
  15.    external 'dos4AH.com';
  16.  
  17. {-------------------- EXECUTE A SUB-PROCESS }
  18. function dos4BH(var program_name,parameter_string):integer;
  19.    external 'dos4BH.com';
  20.  
  21. {--------------- ALLOCATE A NEW MEMORY BLOCK }
  22. function dos48H(pp_needed:integer;var block_segment:integer):integer;
  23.  
  24.    begin
  25.    regs.bx:=pp_needed;           { # of paragraphs required.   }
  26.    regs.ax:=$48 shl 8;           { Function call 48H.          }
  27.    msdos(regs);                  { Call DOS.                   }
  28.    if (regs.flags and 1)<>0 then { Is carry flag set?          }
  29.       begin
  30.       block_segment:=regs.ax;    { Yes, return available pp's, }
  31.       dos48h:=lo(regs.ax);       { and error number.           }
  32.       end
  33.    else
  34.       begin
  35.       block_segment:=regs.ax;    { No, return segment address, }
  36.       dos48h:=0;                 { and error code 0            }
  37.       end;
  38.    end;
  39.  
  40. {--------------------- RELEASE A MEMORY BLOCK }
  41. function dos49H(block_segment:integer):integer;
  42.  
  43.    begin
  44.    regs.es:=block_segment;        { Segment address to release. }
  45.    regs.ax:=$49 shl 8;            { Function call 49H.          }
  46.    msdos(regs);                   { Call DOS.                   }
  47.    if (regs.flags and 1)<>0 then  { Is carry flag set?          }
  48.       dos49H:=lo(regs.ax)         { Yes, return error number.   }
  49.    else
  50.       dos49H:=0;                  { No, return error code 0.    }
  51.    end;
  52.  
  53. {---------------- OBTAIN A PROCESS'S EXIT CODE }
  54. function dos4DH:integer;
  55.  
  56.    begin
  57.    regs.ax:=$4d shl 8;            { Function call 4DH.          }
  58.    msdos(regs);                   { Call DOS.                   }
  59.    dos4dH:=lo(regs.ax);           { Return Exit Code.           }
  60.    end;
  61.  
  62. {--------------- GET COMMAND PROCESSOR NAME   }
  63. function get_comspec(var comspec:asciiz):boolean;
  64.  
  65. type
  66.    dos_env_type=array[1..254] of byte;
  67.    dos_env_string=^dos_env_type;
  68.  
  69. var
  70.    dos_env:dos_env_string;
  71.    dos_envs:string[255];
  72.    idx:integer;
  73.  
  74.    begin
  75.    get_comspec:=false;
  76.    dos_env:=ptr(memw[cseg:$2c],$0); { Get 254 bytes of the DOS    }
  77.    move(dos_env^,dos_envs[1],254);  {     environment string.     }
  78.    dos_envs[255]:=#0;
  79.    dos_envs[0]:=#255;
  80.    idx:=pos('COMSPEC=',dos_envs);   { Find COMSPEC= portion.      }
  81.    if idx=0 then                    { Yikes! No COMSPEC= there!   }
  82.     begin
  83.   writeln('*** "COMSPEC=d:[path]filename" not in DOS environment.');
  84.       get_comspec:=true;
  85.       exit;                         { Return TRUE.                }
  86.     end
  87.    else
  88.       begin
  89.       delete(dos_envs,1,idx+7);     { Isolate the ASCIIZ string   }
  90.       idx:=pos(#0,dos_envs);        {  drive:[path]filename       }
  91.       dos_envs:=copy(dos_envs,1,idx); {  of the command processor.}
  92.       while dos_envs[1]=' ' do
  93.          delete(dos_envs,1,1);
  94.       comspec:=dos_envs;            { Return FALSE.               }
  95.       end;
  96.    end;
  97.  
  98. {----------------------- HANDLE A DOS ERROR CONDITION }
  99. function dos_error_check(error_code:integer):boolean;
  100.  
  101.    type
  102.       error_table_type = array [1..18] of string[41];
  103.  
  104.    const
  105.       error_table: error_table_type =  { RANGE: 1 TO 18 DECIMAL }
  106.         ('Invalid function number',
  107.          'File not found',
  108.          'Path not found',
  109.          'Too many open files (no handles left)',
  110.          'Access Denied',
  111.          'Invalid file handle',
  112.          'Memory control blocks destroyed',
  113.          'Insufficient Memory',
  114.          'Invalid memory block address',
  115.          'Invalid environment',
  116.          'Invalid format',
  117.          'Invalid access code',
  118.          'Invalid data',
  119.          'UNRECOGNIZED ERROR',        { NOT USED BY DOS }
  120.          'Invalid drive was specified',
  121.          'Attempted to remove the current directory',
  122.          'Not same device',
  123.          'No more files');
  124.  
  125.    begin
  126.    dos_error_check:=true;
  127.    if error_code=0 then
  128.       dos_error_check:=false
  129.    else
  130.  writeln('*** DOS error ',error_code,': ',error_table[error_code]);
  131.    end;